Se determina el modelo de servicios diarios entre el períodode 2019 hasta julio de 2024 con frecuencia semanal.
ruta_servicios <- "/cloud/project/df_serv_dif.xlsx"
excel_sheets(ruta_servicios)
## [1] "Sheet1"
servicios <- as.data.frame(read_xlsx(ruta_servicios,
sheet = "Sheet1", col_names = T))
## New names:
## • `` -> `...1`
colnames(servicios) <- c("","Indice", "Fecha", "Totales")
servicios <- select(servicios, c("Indice", "Fecha", "Totales"))
servicios$ ...1 <- NULL
servicios$Semana <- format(x = servicios$Fecha, format = c("%Y-%U"))
nrow(servicios)
## [1] 183
servicios <- servicios %>%
group_by(Fecha = as.character(Semana)) %>%
summarize(Ventas_Totales = sum(Totales),
.groups = "keep")
head(servicios)
## # A tibble: 6 × 2
## # Groups: Fecha [6]
## Fecha Ventas_Totales
## <chr> <dbl>
## 1 2019-26 -1.09
## 2 2019-27 -2.42
## 3 2019-28 2.06
## 4 2019-29 0.444
## 5 2019-30 1.32
## 6 2019-31 -2.56
servicios_sem_ts <- ts(servicios$Ventas_Totales, start = 1, frequency = 1)
servicios_sem_xts <- as.xts(servicios_sem_ts, dateFormat = "POSIXct")
ts_plot(servicios_sem_ts, color = "darkgreen", Xtitle = "Fecha",
Ytitle = "Valores",
title = "Serie de servicios semanales")
plot.xts(x = servicios_sem_xts, bg = "white",
col = "black", labels.col = "black",
main = "Serie de servicios semanales")
urca::ur.df(servicios_sem_ts)
##
## ###############################################################
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test #
## ###############################################################
##
## The value of the test statistic is: -9.7867
El valor del estadístico de Dickey-Fuller es -9.7867. Este resultado, significativamente menor que el valor crítico, nos permite rechazar la hipótesis nula de que la serie tiene una raíz unitaria a un nivel de significancia del 5%. En consecuencia, se concluye que la serie de tiempo es estacionaria.
kpss.test(servicios_sem_ts)
## Warning in kpss.test(servicios_sem_ts): p-value greater than printed p-value
##
## KPSS Test for Level Stationarity
##
## data: servicios_sem_ts
## KPSS Level = 0.050977, Truncation lag parameter = 4, p-value = 0.1
KPSS Level = 0.050977, Truncation lag parameter = 4, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia convencional de 0.05, no se rechaza la hipótesis nula.
ggAcf(servicios_sem_ts, col = "red", lwd = 1, lag.max = 52)
ggPacf(servicios_sem_ts, col = "blue", lag.max = 52, lwd = 1)
div_sem_serv <- ts_split(servicios_sem_ts,
sample.out =
round(length(servicios_sem_ts)*0.2))
entrena_serv_sem <- div_sem_serv$train
prueba_serv_sem <- div_sem_serv$test
modelo_arima_sem_serv <- auto.arima(entrena_serv_sem, stationary = T, stepwise = F)
summary(modelo_arima_sem_serv)
## Series: entrena_serv_sem
## ARIMA(1,0,4) with zero mean
##
## Coefficients:
## ar1 ma1 ma2 ma3 ma4
## 0.5552 -0.9517 0.1917 -0.0482 0.2722
## s.e. 0.1741 0.1826 0.1603 0.1215 0.1086
##
## sigma^2 = 8.076: log likelihood = -256.57
## AIC=525.14 AICc=526 BIC=541.07
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set 0.002082859 2.773311 2.154162 NaN Inf 0.564156 0.001183363
# AIC=525.14 AICc=526 BIC=541.07
# ARIMA(1,0,4) with zero mean
checkresiduals(modelo_arima_sem_serv, col = "red") # p-value = 0.3805
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,0,4) with zero mean
## Q* = 5.2991, df = 5, p-value = 0.3805
##
## Model df: 5. Total lags used: 10
pronostico_sem_serv <- forecast(modelo_arima_sem_serv,
h = length(prueba_serv_sem),
level = 0.95)
prueba_serv_sem <- as.numeric(prueba_serv_sem)
prueba_serv_sem[prueba_serv_sem == 0] <- 1e-6
accuracy(pronostico_sem_serv$mean, prueba_serv_sem)
## ME RMSE MAE MPE MAPE
## Test set 0.004388031 1.742557 1.275248 86608.24 86609.47
# ME RMSE MAE MPE MAPE
# Test set 0.0043878 1.742557 1.275248 86608.24 86609.47
accuracy(pronostico_sem_serv$mean[1:10], prueba_serv_sem[1:10])
## ME RMSE MAE MPE MAPE
## Test set 0.4320913 1.13248 0.9460443 222927.8 222930.9
# ME RMSE MAE MPE MAPE
# Test set 0.4320912 1.13248 0.9460442 222927.8 222930.9
El modelo determinado está muy debajo del mejor, por lo cual no se considera un modelo óptimo.